Attribute VB_Name = "modDatagridScroll"

Public Const MK_RBUTTON = &H2
Public Const MK_MBUTTON = &H10
Public Const MK_SHIFT = &H4
Public Const GWL_WNDPROC = -4
Public Const WM_MOUSEWHEEL = &H20A
Public LocalHwnd As Long
Public LocalPrevWndProc As Long
Public MyControl As Object

Public Declare Function CallWindowProc Lib "user32.dll" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Declare Function SetWindowLong Lib "user32.dll" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public Function WindowProc(ByVal Lwnd As Long, ByVal Lmsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim MouseKeys As Long
    Dim Rotation As Long
    Dim Xpos As Long
    Dim Ypos As Long
    If Lmsg = WM_MOUSEWHEEL Then
        MouseKeys = wParam And 65535
        Rotation = wParam / 65536
        Xpos = lParam And 65535
        Ypos = lParam / 65536
        If Rotation = -120 Then
            MyControl.Scroll 0, 1      'Going Down
        Else
            MyControl.Scroll 0, -1   'Going Up
        End If
    End If
    
'update may6,2011
'to prevent system crash
    Const WM_NCDESTROY = &H82
    Const WM_SYSCOMMAND = &H112
    Const SC_SIZE = &HF000&

    ' If we're being destroyed,
    ' restore the original WindowProc.
    If Msg = WM_NCDESTROY Then
        SetWindowLong hwnd, GWL_WNDPROC, LocalPrevWndProc
    End If

    ' See if this is a WM_SYSCOMMAND message.
    If Msg = WM_SYSCOMMAND Then
        ' This is a WM_SYSCOMMAND message.
        ' If the command is SC_SIZE, ignore it.
        If (wParam And &HFFF0) = SC_SIZE Then Exit Function
    End If
'end of update may6,2011

    WindowProc = CallWindowProc(LocalPrevWndProc, Lwnd, Lmsg, wParam, lParam)
End Function

Public Sub WheelHook(PassedControl As Object)
    On Error Resume Next
    lNot1stRun = True
    Set MyControl = PassedControl
    LocalHwnd = PassedControl.hwnd
    LocalPrevWndProc = SetWindowLong(LocalHwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Sub WheelUnHook()
    Dim WorkFlag As Long
    On Error Resume Next
    WorkFlag = SetWindowLong(LocalHwnd, GWL_WNDPROC, LocalPrevWndProc)
    Set MyControl = Nothing
End Sub

